home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Best of MacTutor - S…e Code for Volumes 1 to 5
/
The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin
/
Source Code
/
#19 (Apr 87)
/
controls.fortran
/
control example.fort
next >
Wrap
Text File
|
1987-03-11
|
9KB
|
288 lines
PROGRAM CONTROLEXAMPLE
*
* THIS PROGRAM IMPLEMENTS SIMPLE CONTROLS IN FORTRAN
*
* AUTHOR: GLENN FORNEY
* DATE: 8/86
IMPLICIT NONE ! HELPS KEEP US OUT OF TROUBLE
*
* THE FOLLOWING INCLUDE FILES ARE INCLUDED WITH MS FORTRAN
* YOU SHOULD CHANGE THE PATHNAMES TO MATCH YOUR SETUP
*
include XP40-6:SoftwareDev:MacFortran:IncludeFiles:window.inc
include XP40-6:SoftwareDev:MacFortran:IncludeFiles:dialog.inc
include XP40-6:SoftwareDev:MacFortran:IncludeFiles:event.inc
include XP40-6:SoftwareDev:MacFortran:IncludeFiles:menu.inc
include XP40-6:SoftwareDev:MacFortran:IncludeFiles:control.inc
include XP40-6:SoftwareDev:MacFortran:IncludeFiles:quickdraw.inc
include XP40-6:SoftwareDev:MacFortran:IncludeFiles:misc.inc
*
* DECLARATIONS
*
INTEGER*4 TOOLBX ! THE TOOL BOX INTERFACE
INTEGER*4 WINDOW ! GENERAL PURPOSE POINTER
INTEGER*2 RECT(4) ! RECTANGLE COORDINATES
INTEGER*4 CONTROL_WINDOW ! POINTER TO THE CONTROL WINDOW
INTEGER DUMMYHANDLE ! HANDLE TO DUMMY WINDOW
INTEGER MENUHANDLE ! HANDLE TO MENUS
*
* WCONTRLLIST IS AN OFFSET THAT GIVES A
* HANDLE TO THE FIRST CONTROL IN A WINDOW
* HEX 8C = DECIMAL 140, SO WCONTROLLIST BEGINS AT THE
* 140'TH BYTE IN THE WINDOW RECORD
*
INTEGER WCONTROLLIST
PARAMETER (WCONTROLLIST = Z'8C')
*
* DECLARATIONS FOR VARIOUS EVENTS AND MOUSE DOWN LOCATIONS
*
INTEGER ACTIVATE,CONTROL_HAN,SAVEPORT
INTEGER MOUSEDOWN,UPDATEEVT,ACTIVATEEVT
PARAMETER (MOUSEDOWN=1,UPDATEEVT=6,ACTIVATEEVT=8)
EVENTMASK = -1 ! PROCESS ALL EVENTS
*
* CLOSE MACFORTRAN I/O WINDOW (NEVER MAKE A DISPOSEWINDOW
* CALL ON THIS WINDOW SINCE WE DIDN'T ALLOCATE IT)
*
WINDOW = TOOLBX(FRONTWINDOW)
CALL TOOLBX(CLOSEWINDOW,WINDOW)
*
* INITIALIZE MENU
*
MENUHANDLE = TOOLBX(NEWMENU, 1,CHAR(7)//"OPTIONS")
CALL TOOLBX(APPENDMENU,MENUHANDLE,
+ CHAR(32)//"CONTROL WINDOW;DUMMY WINDOW;QUIT")
CALL TOOLBX(INSERTMENU,MENUHANDLE,0)
CALL TOOLBX(DRAWMENUBAR)
*
* READ IN CONTROL_WINDOW WITH "REGULAR" CONTROLS FROM
* RESOURCE ID 128, 0 MEANS ALLOCATE STORAGE ON HEAP, -1 MEANS
* BRING WINDOW IN FRONT OF ALL OTHER WINDOWS
*
CONTROL_WINDOW = TOOLBX(GETNEWDIALOG,128,0,-1)
*
* PLACE INFORMATION IN CONTROL_WINDOW'S REFCON FIELD
* TO BE USED BY APPLICATION
*
CALL INITVALUES(CONTROL_WINDOW,2)
*
* SET UP DUMMY WINDOW TO MAKE SURE UPDATE AND ACTIVATE EVENTS
* ARE HANDLED RIGHT
*
RECT(1) = 40
RECT(2) = 30
RECT(3) = 300
RECT(4) = 270
DUMMYHANDLE = TOOLBX(NEWWINDOW,0,RECT,
+ CHAR(12)//"DUMMY WINDOW",.TRUE.,4,-1,.TRUE.,0)
RECT(1) = 25 ! WINDOWDRAG CONTSTRAINTS
RECT(2) = 25
RECT(3) = 300
RECT(4) = 500
*
* MAIN EVENT PROCESSING LOOP
*
DO
IF (TOOLBX(GETNEXTEVENT,EVENTMASK,EVENTRECORD)) THEN
SELECT CASE (WHAT)
CASE (MOUSEDOWN) ! HANDLE MOUSE DOWN
CALL DOMOUSEDOWN(WHERE,WINDOW,DUMMYHANDLE,
1 CONTROL_WINDOW,RECT,EVENTRECORD)
CASE(UPDATEEVT) ! HANDLE UPDATE EVENT
*
* MUST ALWAYS SET THE PORT TO THE WINDOW WHERE OUTPUT IS TO OCCUR
* MESSAGE IS PASSED TO US IN THE EVENT RECORD AND IS A POINTER
* TO THE WINDOW BEING UPDATED
*
CALL TOOLBX(GETPORT,SAVEPORT) ! SAVE THE PORT
CALL TOOLBX(SETPORT,MESSAGE) ! SET PORT TO UPDATE WINDOW
CALL TOOLBX(BEGINUPDATE,MESSAGE) ! ALWAYS USE THIS BEFORE UPDATE
CALL TOOLBX(DRAWCONTROLS,MESSAGE) ! DRAW THE CONTROLS
CALL TOOLBX(ENDUPDATE,MESSAGE) ! ALWAYS USE THIS AFTER UPDATE
CALL TOOLBX(SETPORT,SAVEPORT) ! RESTORE TO PREVIOUS PORT
CASE(ACTIVATEEVT) ! HANDLE ACTIVATE EVENT
CALL TOOLBX(SETPORT,MESSAGE)
ACTIVATE = 255 ! UNHILIGHT CONTROLS
IF(MOD(MODIFIERS,2).EQ.1)ACTIVATE = 0 ! HILIGHT CONTROLS
CONTROL_HAN = LONG(MESSAGE+WCONTROLLIST) ! FIRST CONTROL
*
* LOOP THROUGH ALL CONTROLS IN A WINDOW
*
WHILE(CONTROL_HAN.NE.0)
CALL TOOLBX(HILITECONTROL,CONTROL_HAN,ACTIVATE)
CONTROL_HAN = LONG(LONG(CONTROL_HAN)) ! NEXT CONTROL
REPEAT
CASE DEFAULT
END SELECT
END IF
REPEAT
END
SUBROUTINE DOMOUSEDOWN(WHERE,WINDOW,DUMMYWINDOW,
1 CONTROL_WINDOW,RECT,EVENTRECORD)
*
* THIS ROUTINE HANDLES MOUSE DOWN EVENTS
*
IMPLICIT NONE
INTEGER WINDOW,CONTROL_WINDOW,MOUSELOC
INTEGER TOOLBX,SIZE
INTEGER SAVEPORT,TTY_CT,WHICH_CTRL
INTEGER*2 EVENTRECORD(8) ! OVERLYING STRUCTURE
INTEGER*2 WHERE(2),RECT(4),INVAL_RECT(4),MENUSELECTION(2)
LOGICAL FLAG
INTEGER QUIT, OPTIONS,CIRCLES,MENUDATA,DUMMY,DUMMYWINDOW
PARAMETER (QUIT=3,OPTIONS=1,CIRCLES=1,DUMMY=2)
include XP40-6:SoftwareDev:MacFortran:IncludeFiles:window.inc
include XP40-6:SoftwareDev:MacFortran:IncludeFiles:menu.inc
include XP40-6:SoftwareDev:MacFortran:IncludeFiles:control.inc
include XP40-6:SoftwareDev:MacFortran:IncludeFiles:quickdraw.inc
*
* MOUSE DOWN LOCATIONS
*
INTEGER MENUBAR,SYSTEMWINDOW,CONTENTREGION,DRAGREGION
INTEGER GROWREGION,GOAWAYREGION,NONE
PARAMETER (MENUBAR=1,SYSTEMWINDOW=2,CONTENTREGION=3)
PARAMETER (DRAGREGION=4,GOAWAYREGION=6,NONE=0)
PARAMETER (GROWREGION=5)
EQUIVALENCE (MENUDATA,MENUSELECTION)
MOUSELOC = TOOLBX(FINDWINDOW,WHERE,WINDOW)
IF (MOUSELOC=MENUBAR) THEN
MENUDATA = TOOLBX(MENUSELECT,WHERE)
SELECT CASE (MENUSELECTION(1))
CASE (OPTIONS) ! THE "OPTIONS" MENU WAS SELECTED
SELECT CASE (MENUSELECTION(2))
CASE (CIRCLES)
WINDOW = CONTROL_WINDOW
CASE (DUMMY)
WINDOW = DUMMYWINDOW
CASE (QUIT)
STOP
END SELECT
CALL TOOLBX(SHOWWINDOW,WINDOW)
CALL TOOLBX(SELECTWINDOW,WINDOW)
CALL TOOLBX(HILITEMENU,0)
CASE DEFAULT ! JUST PLAYING WITH THE MOUSE
END SELECT
ELSE IF (MOUSELOC=CONTENTREGION) THEN
CALL TOOLBX(SELECTWINDOW,WINDOW)
*
* HANDLE MOUSEDOWN IN CONTROL
*
CALL TOOLBX(GETPORT,SAVEPORT) ! SAVE CURRENT PORT
CALL TOOLBX(SETPORT,WINDOW) ! SET PORT TO SELECTED WINDOW
CALL TOOLBX(GLOBALTOLOCAL,WHERE) ! CONVERT TO LOCAL COORDINATES
CALL INCONTROL(WHERE,WINDOW) ! HANDLE IT IF MOUSE IS IN CONTROL
CALL TOOLBX(SETPORT,SAVEPORT) ! RESTORE PORT
ELSE IF (MOUSELOC=DRAGREGION) THEN
CALL TOOLBX(DRAGWINDOW,WINDOW,WHERE,RECT)
ELSE IF (MOUSELOC=GOAWAYREGION) THEN
IF (TOOLBX(TRACKGOAWAY,WINDOW,WHERE))
+ CALL TOOLBX(HIDEWINDOW,WINDOW)
END IF
RETURN
END
SUBROUTINE INCONTROL(WHERE,WINDOW)
*
* HANDLE EVENT IF MOUSE IS DOWN IN CONTROL
*
IMPLICIT NONE
INTEGER*2 WHERE(2)
INTEGER WHICH_CTRL,WINDOW,PART_NUMBER,IVALUE4,TOOLBX
include XP40-6:SoftwareDev:MacFortran:IncludeFiles:control.inc
*
* DEFINE SYMBOLIC NAMES FOR CONTROL ITEMS
* NAMING CONVENTION TAKEN FROM INSIDE MACINTOSH
*
INTEGER INBUTTON, INCHECKBOX, INUPBUTTON, INDOWNBUTTON
INTEGER INPAGEUP, INPAGEDOWN, INTHUMB
PARAMETER (INBUTTON=10, INCHECKBOX=11, INUPBUTTON=20)
PARAMETER (INDOWNBUTTON=21, INPAGEUP=22, INPAGEDOWN=23)
PARAMETER (INTHUMB=129)
INTEGER PUSHBUTPROC,CHECKBOXPROC,RADIOBUTPROC,SCROLLBARPROC
PARAMETER (PUSHBUTPROC=0,CHECKBOXPROC=1,RADIOBUTPROC=2)
PARAMETER (SCROLLBARPROC=16)
INTEGER MENUBAR,SYSTEMWINDOW,CONTENTREGION,DRAGREGION
INTEGER GROWREGION,GOAWAYREGION
PARAMETER (MENUBAR=1,SYSTEMWINDOW=2,CONTENTREGION=3)
PARAMETER (DRAGREGION=4,GOAWAYREGION=6)
PARAMETER (GROWREGION=5)
IF(TOOLBX(FINDCONTROL,WHERE,WINDOW,WHICH_CTRL).NE.0)THEN
*
* IS MOUSEUP IN CONTROL? IF SO HANDLE CONTROL
*
PART_NUMBER = TOOLBX(TRACKCONTROL,WHICH_CTRL,WHERE,0)
IF(PART_NUMBER.EQ.INBUTTON)THEN
*
* BUTTON CONTROL DOES NOT NEED TO HAVE ITS VALUE CHANGED
*
ELSE IF(PART_NUMBER.EQ.INCHECKBOX)THEN
IVALUE4 = 1 - TOOLBX(GETCTLVALUE,WHICH_CTRL)
CALL TOOLBX(SETCTLVALUE,WHICH_CTRL,IVALUE4)
*
* IF WE WERE HANDLING SCROLL BARS THEN CODE TO HANDLE MOUSE DOWN
* IN SCROLL BAR PARTS WOULD GO HERE
*
ENDIF
ENDIF
RETURN
END
SUBROUTINE INITVALUES(WINDOW,IVALUE)
*
* INITIALIZE THE REFCON FIELD OF ALL CONTROLS IN WINDOW
*
IMPLICIT NONE
INTEGER WINDOW, IVALUE, CONTROL_HAN,IVAL_CTRL
include XP40-6:SoftwareDev:MacFortran:IncludeFiles:window.inc
include XP40-6:SoftwareDev:MacFortran:IncludeFiles:control.inc
*
* HANDLE TO LIST OF CONTROLS OF THIS WINDOW
*
INTEGER WCONTROLLIST
PARAMETER (WCONTROLLIST = Z'8C')
*
* INITIALIZE THE WINDOW REFCON FIELD
*
CALL TOOLBX(SETWREFCON,WINDOW,IVALUE)
CONTROL_HAN = LONG(WINDOW+WCONTROLLIST) ! FIRST CONTROL IN WINDOW
IVAL_CTRL = 1
IF(IVALUE.EQ.1)IVAL_CTRL = 129
WHILE(CONTROL_HAN.NE.0)
CALL TOOLBX(SETCREFCON,CONTROL_HAN,IVAL_CTRL)
IVAL_CTRL = IVAL_CTRL + 1
*
* NEXT CONTROL IN WINDOW (LAST CONTROL IN WINDOW POINTS TO 0)
*
CONTROL_HAN = LONG(LONG(CONTROL_HAN))
REPEAT
RETURN
END